	PROGRAM COLTAB
C *** LAST REVISED ON 14-AUG-1987 14:27:21.51
C *** SOURCE FILE: [DL.GRAPHICS.LONGLIB]RMCOLTAB.FOR
C
C	MODIFY SELECTED PORTIONS OF THE RAMTEK COLOR TABLE
C	INTERACTIVELY.  COLOR INDEXS CAN BE CHANGED ONE AT A TIME.
C
C	WRITTEN: DGL OCT 1985
C
	INTEGER ARRAY(1024),I,ITEMP,OFFSET,NEWVAL
	DATA I1024/1024/
	CHARACTER*40 NAME
C
C	OPEN RAMTEK CHANNEL
C
	CALL RAMOPEN(ICHAN,1,IDDEV,IERR)
	IF (ICHAN.LT.0) THEN
		TYPE *,'*** RAMTEK NOT AVAILABLE ***'
		CALL EXIT
	ENDIF
C
C	GET COLOR TABLE FROM RAMTEK
C
	CALL RMREADCOL(ICHAN,ARRAY,I1024,IERR)
	IF (IERR.NE.0) THEN
		TYPE *,'*** RAMTEK RMREADCOL ERROR***',IERR
		CALL EXIT
	ENDIF
C
C	TYPE SEND OUT COLOR TABLE TO RAMTEK
C
10	    TYPE 9999
9999	    FORMAT('$Color Table Index: ' )
	    READ (5,9998,END=30) OFFSET
9998	    FORMAT(4I)
	    OFFSET = OFFSET+1
	    ICOL=ARRAY(OFFSET)
	    IB=MOD(ICOL,256)
	    IG=MOD(ICOL,65536)/256
	    IR=(ICOL-IG*256-IB)/65536
	    IR=MOD(IR,256)
	    IX=(ICOL-65536*IR-IG*256-IB)/16711680
	    TYPE 9997, ICOL,IR,IG,IB,IX
9997	    FORMAT('$Newval('I' -> R:'I3' G:'I3' B:'I3' X: 'I4'): ')
	    READ (5,9998,END=30,ERR=10) IR,IG,IB,IX
	    ICOL=IB+256*IG+65536*IR+IX*16711680
	    ARRAY(OFFSET) = ICOL
	    CALL RMWRITECOL(ICHAN,ARRAY,I1024,IERR)
	    IF (IERR.NE.0) THEN
		TYPE *,'*** RAMTEK RMWRITECOL ERROR***',IERR
		CALL EXIT
	    ENDIF
	GOTO 10
30	STOP
	END
